home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / x11 / rpg / crossfir.92 / crossfir / crossfire-0.92.5 / utils / crossrem.pl < prev    next >
Perl Script  |  1996-07-24  |  4KB  |  186 lines
  1. #!/usr/local/bin/perl
  2. push(@INC,"BINDIR");
  3. require('tcpsockets.pl');
  4. require "sys/socket.ph";
  5.  
  6. chop($server = `/bin/hostname`);
  7. $crosservport = 3326;
  8. $display = $ENV{'DISPLAY'};
  9.  
  10. if ($ARGV[0] eq "-server") {
  11.     shift @ARGV;
  12.     $server = shift @ARGV;
  13. }
  14.  
  15. die("Unknown cmd $_, usage $0 [-server host]\n") if defined($_ = shift @ARGV);
  16.  
  17. $fh = &tcpsockets'getconnection($server,$crosservport);
  18.  
  19. print "Hi:$fh\n";
  20. print "Xhosting your machine to $server\n";
  21.  
  22. &system("xhost +$server\n");
  23.  
  24. chop($hostname = `hostname`);
  25.  
  26. ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($hostname);
  27.  
  28. die("Can't gethostbyname of $hostname??") unless defined $addrs[0];
  29.  
  30. ($a, $b, $c, $d) = unpack('C4',$addrs[0]);
  31.  
  32. print "Cleaning up old font things\n";
  33.  
  34. opendir(XDIR,"/tmp");
  35. while ($_ = readdir(XDIR)) {
  36.     next unless /^crossfire-font\.\d+$/o;
  37.     next unless -d "/tmp/$_";
  38.     print "rm -rf /tmp/$_\n";
  39.     system("rm -rf /tmp/$_");
  40. }
  41. closedir(XDIR);
  42.  
  43. $localdir = "/tmp/crossfire-font.$$";
  44.  
  45. mkdir($localdir,0777);
  46.  
  47. chmod 0777 , $localdir;
  48.  
  49. $localname = "$localdir/crossfire.bdf";
  50.  
  51. print "Getting Font...\n";
  52. print "If this doesn't do anything by 5 seconds from now, the server is\n";
  53. print "probably down so you will want to ctrl-c this command\n";
  54.  
  55. &getfont;
  56.  
  57. print "Converting Font...\n";
  58.  
  59. &convertfont;
  60.  
  61. print "Getting old fontpath...\n";
  62.  
  63. open(FONTINFO,"xset q |") || die("Unable to read from pipe of xset q\n");
  64.  
  65. $oldfontpath = undef;
  66.  
  67. while(<FONTINFO>) {
  68.     next unless /^Font Path:$/o;
  69.     $oldfontpath = <FONTINFO>;
  70. }
  71. close(FONTINFO);
  72.  
  73. die("Old fontpath not defined\n") unless defined $oldfontpath;
  74.  
  75. chop ($oldfontpath);
  76.  
  77. @fpaths = split(/,/,$oldfontpath);
  78.  
  79. foreach $path (@fpaths) {
  80.     if ($path =~ m!^/tmp/crossfire-font!) {
  81.     print "Removing $path from font path\n";
  82.     next;
  83.     }
  84.     push(@newpath,$path);
  85. }
  86.  
  87. $newpath = join(',',@newpath);
  88.  
  89. print "Adding to fontpath...\n";
  90.  
  91. &system("xset fp $newpath,$localdir");
  92.  
  93. print "Waiting 5 seconds ...\n";
  94. sleep(5);
  95.  
  96. print "Adding Window...\n";
  97.  
  98. #print $fh "window $a.$b.$c.$d\n";
  99. print $fh "window $display\n";
  100.  
  101. print $fh "quit\n";
  102.  
  103. close($fh);
  104.  
  105. print "Your window should appear in a little while\n";
  106. print "If it doesn't, you can try this command again.\n";
  107.  
  108. sub getfont {
  109.     &open_recieve_data_socket;
  110.     open (OUTFILE,">$localname") || die("Unable to open file to write.\n");
  111.     $loop=0;
  112.     print "BYTES:";
  113.     $foo='';
  114.     while ($size = sysread(DS,$foo,4096)) {
  115. #       $diff = ($size-$loop)<$blocksize?$size-$loop:$blocksize;
  116. #       print "$size,$loop,$diff\n";
  117.         syswrite(OUTFILE,$foo,$size);
  118.         $loop += $size;
  119.         print "$loop";
  120.         print "\b" x length("$loop");
  121.     }
  122.     print "\n";
  123. #    syswrite(DS,$foo,$len) while($len=sysread(DS,$foo,$blocksize));
  124.     close (OUTFILE);
  125.     close(DS);
  126.     close($acceptsocket);
  127. }
  128.  
  129. sub open_recieve_data_socket
  130. {
  131.     ($a,$b,$c,$d) = &tcpsockets'getlocaladdress;
  132.     
  133.     $acceptsocket = &tcpsockets'getacceptor(0);
  134.     
  135.     # get the port number
  136.     $port = &tcpsockets'getportnumber($acceptsocket);
  137.     
  138.     unless(print $fh "sendfont $a.$b.$c.$d $port\n") {
  139.     die("Unable to ask for font from server.  It died??\n");
  140.     }
  141.     
  142.     ($addr = accept(DS,$acceptsocket)) || die("accept failed $!");
  143.     $oldfh = select(DS);$|=1;select($oldfh);
  144.     return $addr;
  145. }
  146.  
  147. sub convertfont {
  148.     foreach $path (split(/:/,$ENV{'PATH'})) {
  149.     $usepcf = 1 if (-x "$path/bdftopcf");
  150.     $usesnf = 1 if (-x "$path/bdftosnf");
  151.     $hasmkfontdir = 1 if (-x "$path/mkfontdir");
  152.     }
  153.     unless ($hasmkfontdir) {
  154.     die("Unable to find mkfontdir in your path\n");
  155.     }
  156.     unless ($usepcf||$usesnf) {
  157.     die("Unable to find either bdftopcf or bdftosnf in your path\n");
  158.     }
  159.     if ($usepcf) {
  160.     $finalname = $localname;
  161.     $finalname =~ s/\.bdf/.pcf/;
  162.  
  163.     &system("bdftopcf $localname >$finalname");
  164.     }
  165.     if ($usesnf) {
  166.     $finalname = $localname;
  167.     $finalname =~ s/\.bdf/.snf/;
  168.  
  169.     &system("bdftosnf $localname >$finalname");
  170.     }
  171.     &system("mkfontdir $localdir");
  172.     open(BEH,">$localdir/fonts.alias")
  173.     || die("Unable to open $locldir/fonts.alias for write\n");
  174.     close(BEH);
  175. }
  176.  
  177. sub system {
  178.     local($cmd) = @_;
  179.  
  180.     print "$cmd\n";
  181.  
  182.     $retval = system($cmd)>>8;
  183.  
  184.     die("Command failed($retval)") unless $retval==0;
  185. }
  186.